home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 072 - EXFER 4.1 4.2.dsk / EXFER.SYS.S < prev    next >
Text File  |  2019-02-17  |  22KB  |  616 lines
  1.                          ; *****************************
  2.                          ;
  3.                          ;            EXfer:
  4.                          ; The Extended Transfer Module
  5.                          ;
  6.                          ;  This program is for use on
  7.                          ;  the ProDOS version of GBBS
  8.                          ;          "Pro" 1.3
  9.                          ;
  10.                          ;   Created and Copyrighted
  11.                          ;        1986 and 1987
  12.                          ;     by Mike Golaszewski
  13.                          ;
  14.                          ;   Copyright 1988 by G-Tech
  15.                          ;     All Rights Reserved
  16.                          ;
  17.                          ; *****************************
  18.  
  19.                          ; system segment, version 4.2
  20.  
  21.                          ; created 6/20/88 - modified 7/17/88
  22.  
  23.                          ; define link in labels
  24.  
  25.           public add
  26.           public create
  27.           public external
  28.           public sort
  29.           public credit
  30.  
  31.                          ; external commands
  32.                          ; ~~~~~~~~~~~~~~~~~
  33.  
  34.                          ; get & parse command string
  35.  
  36. external
  37.           on nocar goto terminate
  38.           input @2 "External:" i$
  39.           a=instr(" ",i$):if a=0 goto ret
  40.           x$=left$(i$,a-1):b=instr(",",i$)
  41.           if not(b) then y$=mid$(i$,a+1):z$="":goto ext.1
  42.           y$=mid$(i$,a+1,b-1):z$=mid$(i$,b+1)
  43.  
  44. ext.1
  45.           if x$="D" or x$="DUMP" goto dump
  46.           if x$="H" or x$="HELP" goto hedit
  47.           if x$="S" or x$="SWAP" goto swap
  48.           if x$="P" or x$="PURGE" goto purge
  49.           if x$="R" or x$="RESET" goto reset
  50.           if x$="T" or x$="TYPE" goto change
  51.           print \"XT:"chr$(7)" Command not recognized!":goto ret
  52.  
  53.                          ; :::::::::::::::::::::::::::::::::::::
  54.                          ; external command functions begin here
  55.                          ; :::::::::::::::::::::::::::::::::::::
  56.  
  57.                          ; do a mass retyping of an EXfer directory
  58.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  59.  
  60. change
  61.           b=val(y$):y$=z$:ob=bb:bb=b:gosub log:if bf$="" then bb=ob:push ret:goto log
  62.           c=256
  63.  
  64.                          ; see if the file type the user has specified is valid
  65.  
  66.           x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
  67.           x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT200PAS239CMD240"
  68.           x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  69.           y=instr(y$,x$):if y then c=val(mid$(x$,y+3,3))
  70.           if c=256 print \"XT: Unsupported file type!":goto ret
  71.  
  72.                          ; print a screen header
  73.  
  74.           print \" #  Filename       Type"\
  75.  
  76.                          ; go through each file and see if it is to be changed
  77.  
  78.           for z=2 to byte(4):i$=str$(z):gosub nread:i$=f$:y$=ty$:f$=bf$+f$:gosub dtype
  79.           f$=i$:i$=y$:y$=ty$:ty$=i$:if not(l) goto change.1
  80.  
  81.           print right$("00"+str$(l),3)" "f$" "ty$"....change this to "y$"? (Y/N/Q):";
  82.           get i$:if i$="N" print chr$(8,56);chr$(32,56);chr$(8,56);:goto change.1
  83.           if i$="Q" print chr$(8,56);chr$(32,56);chr$(8,56);:z=byte(4):goto change.1
  84.           na$=f$:i$=f$:ty$=y$:open #1,d1$:position #1,32,l:print #1,na$
  85.           print #1,ty$:write #1,ram2+9,10:close:gosub name:f$=bf$+f$
  86.           x=c:gosub type:print chr$(8,56);chr$(32,56);chr$(8,56);
  87.  
  88. change.1
  89.           next:push ret:goto log
  90.  
  91.                          ; swap two libraries
  92.                          ; ~~~~~~~~~~~~~~~~~~
  93.  
  94. swap
  95.           b=val(y$):c=val(z$)
  96.           if (b<1 or b>255) or (c<1 or c>255) or (b=c) goto ret
  97.  
  98.                          ; commence swapping
  99.  
  100.           i$="R D:XV."+str$(b)+",D:X.TEMP"
  101.           use "b:xdos",i$:i$="R D:XV."+str$(c)+",D:XV."+str$(b)
  102.           use "b:xdos",i$:i$="R D:X.TEMP,D:XV."+str$(c)
  103.           use "b:xdos",i$:i$="R D:DV."+str$(b)+",D:X.TEMP"
  104.           use "b:xdos",i$:i$="R D:DV."+str$(c)+",D:DV."+str$(b)
  105.           use "b:xdos",i$:i$="R D:X.TEMP,D:DV."+str$(c)
  106.           use "b:xdos",i$
  107.  
  108.                          ; update the bit map
  109.  
  110.           open #1,"d:xt.bitmap":read #1,ed+1,255:close
  111.           x=peek(ed+b):y=peek(ed+c):poke ed+b,y:poke ed+c,x
  112.           open #1,"d:xt.bitmap":write #1,ed+1,255:close
  113.  
  114.                          ; switch names in volume file
  115.  
  116.           open #1,"d:xt.volumes":position #1,32,b
  117.           input #1,x$:position #1,32,c:input #1,y$
  118.           position #1,32,b:print #1,y$:position #1,32,c
  119.           print #1,x$:close:print \"XT: Libraries swapped...."
  120.           push ret:goto log
  121.  
  122.                          ; edit entry in the help file
  123.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  124.  
  125. hedit
  126.           x=instr(y$,"CDFHIKLMNRSTVX?BGQWY"):if not(x) goto ret
  127.           ready "d:hlp.exfer":input #msg(x),a,x$:input #6,x$
  128.           edit(0):copy #6,#8:print '
  129. Edit      help message: 'edit(3)' cols, [4K] max
  130. [DONE]    when finished, [.H] for help'
  131.           edit(1):if not(edit(2)) goto ret
  132.           print \"XT: Enter command line [ie: D)irectory]"
  133.           input @3 "  ->" i$:if i$="" goto ret:else kill #msg(x)
  134.           print #msg(x),x,y$:print #6,i$:copy #8,#6:msg(x)=1
  135.           update:ready d2$:goto ret
  136.  
  137.                          ; purge files from a directory
  138.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  139.  
  140. purge
  141.           x=val(y$):ob=bb:bb=x:gosub log:if bf$="" then bb=ob:push ret:goto log
  142.           print \"XT: ["bn$"]"\:input @2 "XT: Purge this volume? ([Y]/N):" i$
  143.           i$=left$(i$,1):if i$="N" then bb=ob:push ret:goto log
  144.           input @2 \"XT: Remove files from disk? ([Y]/N):" z$
  145.           open #1,d1$:print \"XT: "byte(4)" entries; purging #002";
  146.           for l=1 to byte(4):print chr$(8,3);right$("00"+str$(l),3);
  147.           position #1,32,l+1:input #1,i$:if i$="" next:goto purge.1
  148.           if z$<>"N" gosub name:f$=bf$+f$:kill f$
  149.           position #1,32,l+1:print #1,chr$(13):next
  150.  
  151. purge.1
  152.           close:print chr$(8,3)"---":byte(4)=2:open #1,d1$
  153.           print #1,bn$:print #1,bf$:write #1,ram2,9:close
  154.           ready " ":kill d2$:print '
  155. XT:       Creating new description file....':gosub make.msg:ready d2$
  156.           bb=ob:push ret:goto log
  157.  
  158.                          ; erase trashed file information
  159.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  160.  
  161. reset
  162.           x=val(y$):ob=bb:bb=x:gosub log:if bf$="" then ob=bb:push ret:goto log
  163.           print \"XT: ["bn$"]"\:input @2 "XT: Reset file information? ([Y]/N):" i$
  164.           i$=left$(i$,1):if i$="N" then bb=ob:push ret:goto log
  165.           open #1,d1$:print \"XT: "byte(4)" entries; erasing #002";
  166.           for l=1 to byte(4):print chr$(8,3);right$("00"+str$(l),3);
  167.           position #1,32,l+1:input #1,i$:if i$="" next:goto reset.1
  168.           input #1,x$:read #1,ram2+9,10:byte(14)=0:position #1,32,l+1
  169.           print #1,i$:print #1,x$:write #1,ram2+9,10:next
  170.  
  171. reset.1
  172.           close:print chr$(8,3)"---":ready " ":kill d2$:print '
  173. XT:       Creating new description file....':gosub make.msg:ready d2$
  174.           bb=ob:push ret:goto log
  175.  
  176.                          ; send a directory to the printer
  177.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  178.  
  179. dump
  180.           x=val(y$):ob=bb:bb=x:gosub log:if bf$="" then ob=bb:push ret:goto log
  181.           y=5:gosub dir.h:use "d:xtyp",bf$:open #1,d1$:for l=1 to byte(4)
  182.           position #1,32,l+1:input #1,i$:input #1,ty$:position #1,32,l+1,20
  183.           read #1,ram2+9,10:if i$="" goto dump.1:else na$=i$:gosub name
  184.           a$=bf$+f$:f$=na$:gosub dir.e:print #5
  185.  
  186. dump.1
  187.           next:close
  188.  
  189.                          ; print
  190.  
  191.           x=peek(865)+peek(866)*256:y=peek(867)+peek(868)*256:z=x-y
  192.           print #5,\"Kbytes Free: "left$(str$(z)+chr$(32,3),4);
  193.           print #5,"     "right$("   Kbytes Used: "+str$(y),17);
  194.           print #5,"        Total Kbytes: "x:print #5,chr$(12)
  195.           bb=ob:push ret:goto log
  196.  
  197.                          ; :::::::::::::::::::::::::::::::::::
  198.                          ; external commands routines end here
  199.                          ; :::::::::::::::::::::::::::::::::::
  200.  
  201.                          ; edit a user's credit status
  202.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  203.  
  204. credit
  205.           input @2 "Credit record of user #" i$:if i$="" goto ret
  206.           a=val(i$):if v=13 x=128:else x=64
  207.           open #1,"b:users":position #1,x,a:input #1,i$,x$:close
  208.           if i$="" print '
  209. XT:       No such user....':goto ret
  210.           print '
  211. XT:       'i$' 'x$:open #1,"d:xt.users":position #1,4,a:read #1,ram2,4:close
  212.           x=byte(2)+byte(3)*256:if not(byte(1)) input @2 '
  213. XT:       This user does not yet have an
  214.              EXfer credit account.  Set one
  215.              up now? ([Y]/N):' i$:if i$<>"N" then byte(1)=1:x=250
  216.           print '
  217. XT:       This user has 'x' credits.'
  218.           input @2 '
  219. XT:       Enter new value or press [RETURN]
  220.              to exit:' i$:if i$="" goto credit.1
  221.           x=val(i$):if x<0 then x=0
  222.  
  223. credit.1
  224.           byte(2)=x mod 256:byte(3)=x/256:open #1,"d:xt.users"
  225.           position #1,4,a:write #1,ram2,4:close:print '
  226. XT:       Credit status updated....':goto ret
  227.  
  228.                          ; optimize directory
  229.                          ; ~~~~~~~~~~~~~~~~~~
  230.  
  231. sort
  232.           on nocar goto terminate
  233.           input @2 "Sort by? ([N]ame T)ype Q)uit):" i$:if i$="" i$="N"
  234.           if i$="Q" goto ret
  235.           print \"XT: "byte(4)" entries; sorting #002";:open #1,d1$:x=2
  236.  
  237.                          ; use the GS SBS algorithm
  238.  
  239. sort.1
  240.           position #1,32,x:input #1,a$:input #1,y$
  241.           position #1,32,x,20:read #1,ram2+9,10
  242.           position #1,32,x+1:input #1,b$:input #1,z$
  243.           if b$="" goto sort.3:else if a$="" goto sort.2
  244.           if (i$<>"T") and (a$<=b$) goto sort.3
  245.           if (i$="T") and (y$<=z$) goto sort.3
  246.  
  247.                          ; swap entries around
  248.  
  249. sort.2
  250.           position #1,32,x+1,20:read #1,ram2+20,10
  251.           position #1,32,x:print #1,b$:print #1,z$:write #1,ram2+20,10
  252.           position #1,32,x+1:print #1,a$:print #1,y$:write #1,ram2+9,10
  253.           if x>2 then x=x-1:print chr$(8,3);right$("00"+str$(x),3);
  254.           goto sort.1
  255.  
  256. sort.3
  257.           x=x+1:print chr$(8,3);right$("00"+str$(x),3);
  258.           if x<=byte(4) goto sort.1:else close:print chr$(8,3)"---"
  259.           goto ret
  260.  
  261.                          ; add a file to the directory
  262.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  263.  
  264.                          ; get filename to add
  265.  
  266. add
  267.           on nocar goto terminate
  268.           if nb=255 goto dfull
  269.           d=0:input @2 "Add:" i$:if i$="" goto ret
  270.           na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  271.           if l=0 goto add.1
  272.  
  273.                          ; see if existing directory entry is to be replaced
  274.  
  275.           input @2 \"XT: Replace existing entry? ([Y]/N):" x$
  276.           if x$="N" goto ret:else nb=l:d=byte(14)
  277.  
  278.                          ; file doesn't exist on ProDOS volume
  279.  
  280. add.1
  281.           i$=na$:gosub name:f$=bf$+f$:gosub chkfil:close
  282.           if not(a) goto add.2:else print \"XT: "f$" doesn't exist on "bf$
  283.           input @2 "    Add anyway? ([Y]/N):" i$
  284.           if i$="N" goto ret
  285.  
  286.                          ; compute some file info
  287.  
  288. add.2
  289.           gosub dtype:gosub size:gosub sfile:byte(9)=255:byte(14)=0
  290.  
  291.                          ; ask for a description
  292.  
  293.           on nocar goto add.3
  294.           if d print '
  295. XT:       Do you want to change the existing
  296.              file information? ([Y]/N):';:else print '
  297. XT:       Would you like to enter a short
  298.              description of this file? ([Y]/N):';
  299.           input @2 i$:i$=left$(i$,1):if i$="N" goto add.3
  300.           edit(0):if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
  301.           gosub edesc:if not(edit(2)) goto add.3
  302.           if d then byte(14)=d:kill #msg(d):update:goto add.i
  303.           a=1
  304.  
  305. add.f
  306.           if msg(a) then a=a+1:else d=a:goto add.i
  307.           if a>msg(0) then d=a:goto add.i
  308.           goto add.f
  309.  
  310. add.i
  311.           kill #msg(d):print #msg(d),un:print #6,na$
  312.           print #6,"Uploader: "a1$" "a2$" [#"un"]"
  313.           print #6,"Uploaded: "date$" "time$\:copy #8,#6
  314.           msg(d)=255:update
  315.  
  316. add.3
  317.           if d then byte(14)=d
  318.           d=1:if nb<>byte(4) goto write:else goto update
  319.  
  320.                          ; routine to create libraries
  321.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  322.  
  323.                          ; set defaults for new directory
  324.  
  325. create
  326.           if bf$<>"" goto create.1
  327.           bn$="New directory"+chr$(32,17):bf$="D:  "
  328.           byte(0)=1:byte(1)=1:byte(2)=1:byte(3)=0
  329.           byte(4)=2:byte(5)=0:byte(6)=0:zz$="x"
  330.  
  331.                          ; print info to the screen
  332.  
  333. create.1
  334.           on nocar goto terminate
  335.           if byte(7)>20 then byte(7)=20
  336.           if byte(8)>20 then byte(8)=20
  337.           if byte(0)>byte(1) then byte(1)=byte(0)
  338.           if byte(0)>byte(2) then byte(2)=byte(0)
  339.           print \\screen$"XT: Library #"right$("00"+str$(bb),3)"...."\
  340.           print "1-Name...."bn$\"2-Drive...."bf$\
  341.           print "3-Librarian: ";:if not(b1) print "None":else print b1
  342.           print \"4-Access level: "byte(0)\"5-Upload level: "byte(2)
  343.           print "6-D/load level: "byte(1)\
  344.           print "7-Auto-validate files? ";:if not(byte(3)) print "No"
  345.           if byte(3) print "Yes"
  346.           print \"8-Uploads: 1K * "byte(7)" credits"
  347.           print "9-D/loads: 1K * "byte(8)" credits"
  348.           input @2 \"Change which? (1-9):" i$:if i$="" goto create.2
  349.  
  350.                          ; change an option
  351.  
  352.           if i$="1" input @3 \"Name: " i$:bn$=left$(i$+chr$(32,29),30):i$=""
  353.           if (i$="2") and (info(5)) input @2 \"Drive: " i$:bf$=left$(i$+chr$(32,3),4)
  354.           if i$="3" input \"Librarian's user #: " x$:b1=val(x$)
  355.           if i$="3" then byte(6)=b1/256:byte(5)=b1 mod 256:i$=""
  356.           if i$="4" input \"Access level: " i$:byte(0)=val(i$):i$=""
  357.           if i$="5" input \"Upload level: " i$:byte(2)=val(i$):i$=""
  358.           if i$="6" input \"D/load level: " i$:byte(1)=val(i$):i$=""
  359.           if i$="8" input \"Upload multiplier: " i$:um=val(i$):byte(7)=um:i$=""
  360.           if i$="9" input \"D/load multiplier: " i$:dm=val(i$):byte(8)=dm:i$=""
  361.           if i$<>"7" goto create.1
  362.           if byte(3)=0 then byte(3)=255:goto create.1
  363.           byte(3)=0:goto create.1
  364.  
  365.                          ; see if the directory is to be saved
  366.  
  367. create.2
  368.           input @2 \"XT: Save this? ([Y]/N):" i$
  369.           if i$="N" bb=ob:gosub log:push ret:goto getslt
  370.  
  371.                          ; update the bit-map
  372.  
  373.           d=1:print \"XT: Updating volume bit-map...."
  374.           open #1,"d:xt.bitmap":read #1,ed+1,255:close
  375.           poke ed+bb,byte(0):open #1,"d:xt.bitmap"
  376.           write #1,ed+1,255:close:open #1,"d:xt.volumes"
  377.           position #1,32,bb:print #1,bn$:close
  378.  
  379.                          ; save the stuff
  380.  
  381.           z$="d:xv."+str$(bb):if zz$="x" create d1$
  382.           open #1,z$:print #1,bn$:print #1,bf$:write #1,ram2,9
  383.           close
  384.  
  385.           if zz$<>"x" gosub log:push ret:goto getslt
  386.  
  387.                          ; make a new message file for this library
  388.  
  389.           zz$="":print \"XT: Making description file...."
  390.           gosub make.msg:gosub log:push ret:goto getslt
  391.  
  392.                          ; return to main module
  393.                          ; ~~~~~~~~~~~~~~~~~~~~~
  394.  
  395. ret
  396.           link "a:exfer.seg","prompt"
  397.  
  398.                          ; loss of carrier
  399.                          ; ~~~~~~~~~~~~~~~
  400.  
  401. terminate
  402.           link "a:exfer.seg","terminate"
  403.  
  404.                          ; ::::::::::::::::::::
  405.                          ; disk I/O subroutines
  406.                          ; ::::::::::::::::::::
  407.  
  408.                          ; get an empty slot
  409.                          ; ~~~~~~~~~~~~~~~~~
  410.  
  411. getslt
  412.           nb=0:open #1,d1$:for l=1 to byte(4)
  413.           position #1,32,l+1:input #1,i$
  414.           if (i$="") and (nb=0) then nb=l:l=byte(4)
  415.           next:close:if not(nb) then nb=byte(4)
  416.           return
  417.  
  418.                          ; log to a volume
  419.                          ; ~~~~~~~~~~~~~~~
  420.  
  421. log
  422.           byte=ram2:fill ram2,64,0:bf$="":z$="d:xv."+str$(bb)
  423.           open #1,z$:input #1,bn$:input #1,bf$
  424.           read #1,ram2,9:close:b1=byte(5)+byte(6)*256
  425.           b2=1:if byte(0) then b2=flag(byte(0))
  426.           b3=1:if byte(1) then b3=flag(byte(1))
  427.           b4=1:if byte(2) then b4=flag(byte(2))
  428.           um=byte(7):dm=byte(8):lb=(b1=un)
  429.           if info(5) then lb=1:b2=1:b3=1:b4=1
  430.           d1$="d:xv."+str$(bb):d2$="d:dv."+str$(bb)
  431.           if bf$ then ready d2$:bf$=left$(bf$,instr(":",bf$))
  432.           return
  433.  
  434.                          ; make a description file
  435.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  436.  
  437. make.msg
  438.           y=256:z=256:f$="d:dv."+str$(bb)
  439.           y=(y/128)*128:z=(z/128)*128:l=(y/32)+(z/128)
  440.           fill ram2,64,0:byte(0)=z/128:byte(1)=y/32
  441.           create f$:open #1,f$:write #1,ram2,8
  442.           fill ram2,64,0:for x=1 to l:write #1,ram2,64
  443.           write #1,ram2,64:next:close:x=6:goto type
  444.  
  445.                          ; update "number of entries" counter
  446.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  447.  
  448. update
  449.           byte(4)=byte(4)+1:open #1,d1$:print #1,bn$
  450.           print #1,bf$:write #1,ram2,9:close
  451.  
  452.                          ; write a directory entry
  453.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  454.  
  455. write
  456.           open #1,d1$:position #1,32,nb+1:print #1,na$
  457.           print #1,ty$:write #1,ram2+9,10:close #1
  458.           push ret:goto getslt
  459.  
  460.                          ; read a directory entry
  461.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  462.  
  463. read
  464.           open #1,d1$:for l=1 to byte(4)
  465.           position #1,32,l+1:input #1,f$
  466.           if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
  467.           next:close:l=0:return
  468.  
  469. read.1
  470.           input #1,ty$:read #1,ram2+9,10
  471.           return
  472.  
  473.                          ; read a file by slot #
  474.                          ; ~~~~~~~~~~~~~~~~~~~~~
  475.  
  476. nread
  477.           if left$(i$,1)="#" then i$=mid$(i$,2)
  478.           l=val(i$):if (l<2) or (l>253) then l=0:return
  479.           open #1,d1$:position #1,32,l
  480.           input #1,f$:if f$="" close #1:l=0:return
  481.           input #1,ty$:read #1,ram2+9,10:close #1
  482.           i$=f$:return
  483.  
  484.                          ; show a directory header
  485.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  486.  
  487. dir.h
  488.           print #y,right$("00"+str$(bb),3)": "bn$;
  489.           print #y,"                        Librarian: "right$("00"+str$(b1),3)
  490.           print #y,'
  491.           #  Filename        Typ I Size Uploaded Uploader Downloaded Miscellaneous'\
  492.           return
  493.  
  494.                          ; display an entry
  495.  
  496. dir.e
  497.           print #y,right$("00"+str$(l+1),3)" "f$" "ty$" ";
  498.           if byte(14) print #y,"Y ";:else print #y,"N ";
  499.           x=byte(10)+byte(11)*256:print #y,right$("   "+str$(x),4)" ";
  500.           b$=when$:if (not(byte(9))) print #y,"VALIDATE";:else print #y,b$;
  501.           z=byte(18):x=byte(12)+byte(13)*256
  502.           print #y," User " right$("00"+str$(x),3);
  503.           print #y,"  "right$("00"+str$(z),3)" times "a$;
  504.           return
  505.  
  506.                          ; find the type of a file
  507.                          ; ~~~~~~~~~~~~~~~~~~~~~~~
  508.  
  509. dtype
  510.           use "d:xtyp",f$:x=peek(ram2+32)
  511.           x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
  512.           x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT200PAS239CMD240"
  513.           x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  514.           ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):goto id
  515.           ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
  516.  
  517.                          ; detect Macbinary or Binary ][ formats
  518.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  519.  
  520. id
  521.           x$=right$(f$,4)
  522.           if (x$=".BNY") or (x$=".BQY") or (x$=".SQZ") then ty$=right$(x$,3):return
  523.           open #1,f$:read #1,ram2+32,3:close #1
  524.           if (byte(32)=10) and (byte(33)=71) and (byte(34)=76) then ty$="BNY"
  525.           if (ty$="???") and ((byte(32)=0) and (byte(33))) then ty$="MAC"
  526.           return
  527.  
  528.                          ; set a file type
  529.                          ; ~~~~~~~~~~~~~~~
  530.  
  531. type
  532.           use "d:xtyp",f$,x:return
  533.  
  534.                          ; return size of F$ in A
  535.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  536.  
  537. size
  538.           open #1,f$:a=size(1)/2+1:close:return
  539.  
  540.                          ; see if file exists
  541.                          ; ~~~~~~~~~~~~~~~~~~
  542.  
  543. chkfil
  544.           open #1,f$:a=mark(1):return
  545.  
  546.                          ; :::::::::::::::::::
  547.                          ; special subroutines
  548.                          ; :::::::::::::::::::
  549.  
  550.                          ; get a file description
  551.                          ; ~~~~~~~~~~~~~~~~~~~~~~
  552.  
  553. edesc
  554.           print '
  555. Enter     description: 'edit(3)' cols, [4K] max
  556. [DONE]    when finished, [.H] for help'
  557.           edit(1):return
  558.  
  559.                          ; convert to a valid ProDOS name
  560.                          ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  561.  
  562.                          ; shorten I$ to directory length
  563.  
  564. name
  565.           if len(i$)>15 then i$=left$(i$,15)
  566.           i$=i$+chr$(1)
  567.  
  568.                          ; make sure the first char is a letter
  569.  
  570. name.0
  571.           a=asc(left$(i$,1)):if a=1 pop:goto ret
  572.           if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
  573.           if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
  574.           i$=mid$(i$,2):goto name.0
  575.  
  576.                          ; remove symbols from the name
  577.  
  578. name.1
  579.           f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
  580.           if (a>64) and (a<91) goto name.2
  581.           if (a>96) and (a<123) goto name.2
  582.           if (a>47) and (a<58) goto name.2
  583.           if a=46 goto name.2:else goto name.3
  584.  
  585.                          ; add a valid character
  586.  
  587. name.2
  588.           f$=f$+chr$(a)
  589.  
  590.                          ; if we dont have a name, return to the prompt
  591.  
  592. name.3
  593.           next:if f$="" pop:return
  594.           if len(f$)>15 then f$=left$(f$,15)
  595.           return
  596.  
  597.                          ; set file information
  598.                          ; ~~~~~~~~~~~~~~~~~~~~
  599.  
  600. sfile
  601.           byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
  602.           byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
  603.           when$="x":if lb then byte(9)=255
  604.           return
  605.  
  606.                          ; ::::::::::::::
  607.                          ; error messages
  608.                          ; ::::::::::::::
  609.  
  610. nfile
  611.           print \\"XT:"chr$(7)" No such file....":goto ret
  612.  
  613. dfull
  614.           print \\"XT:"chr$(7)" Directory full....":goto ret
  615.  
  616.